home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mac Magazin/MacEasy 11
/
Mac Magazin and MacEasy Magazine CD - Issue 11.iso
/
Sharewarebibliothek
/
Entwickler
/
WASTE 1.1b1 Distribution
/
Demo Source
/
WETabs.p
< prev
Wrap
Text File
|
1995-06-01
|
9KB
|
350 lines
unit WETabs;
{ Hooks for adding tab support to WASTE }
{ Original C code by Mark Alldritt }
{ Line breaking code by Dan Crevier }
{ Support for horizontal scrolling by Bert Seltzer }
{ Pascal port by Marco Piovanelli, February 1995 }
interface
uses
WASTE;
function WEInstallTabHooks (hWE: WEHandle): OSErr;
function WERemoveTabHooks (hWE: WEHandle): OSErr;
function WEIsTabHooks (hWE: WEHandle): Boolean;
implementation
uses
ToolUtils;
const
kOneToOneScaling = $00010001; { 1:1 scaling ratio }
kTab = 9;
kTabWidth = 32;
var
{ static variables }
sDrawTextHook: WEDrawTextUPP;
sPixelToCharHook: WEPixelToCharUPP;
sCharToPixelHook: WECharToPixelUPP;
sLineBreakHook: WELineBreakUPP;
procedure _WETabDrawText (pText: Ptr;
textLength: LongInt;
slop: Fixed;
styleRunPosition: JustStyleCode;
hWE: WEHandle);
var
destRect: LongRect;
ii, beginChar: LongInt;
tabWidth: Integer;
penPos: Point;
begin
WEGetDestRect(destRect, hWE);
beginChar := 0;
for ii := 0 to textLength - 1 do
begin
if (Ptr(LongInt(pText) + ii)^ = kTab) then
begin
DrawText(pText, beginChar, ii - beginChar);
{ advance the pen to the next tab stop }
GetPen(penPos);
tabWidth := kTabWidth - (Integer(penPos.h - destRect.left) mod kTabWidth);
MoveTo(penPos.h + tabWidth, penPos.v);
beginChar := ii + 1;
end;
end; { for }
DrawText(pText, beginChar, textLength - beginChar);
end; { _WETabDrawText }
function _WETabPixelToChar (pText: Ptr;
textLength: LongInt;
slop: Fixed;
var width: Fixed;
var edge: SignedByte;
styleRunPosition: JustStyleCode;
hPos: Fixed;
hWE: WEHandle): LongInt;
var
ii, beginChar, offset: LongInt;
lastWidth, tabWidth: Fixed;
tempPoint: Point;
begin
beginChar := 0;
offset := 0;
tempPoint := Point(kOneToOneScaling);
{ loop through every character in the segment looking for tabs }
for ii := 0 to textLength - 1 do
begin
{ exit now if width has gone negative (i.e. if we have found which glyph was hit) }
if (width <= 0) then
Leave;
{ tab found? }
if (Ptr(LongInt(pText) + ii)^ = kTab) then
begin
{ calculate the width of the sub-segment preceding the tab }
lastWidth := width;
offset := offset + PixelToChar(Ptr(LongInt(pText) + beginChar), ii - beginChar, slop, lastWidth, Boolean(edge), width, styleRunPosition, tempPoint, tempPoint);
beginChar := ii + 1;
{ hit point past sub-segment? }
if (width >= 0) then
begin
{ increment hPos by width of sub-segment preceding the tab }
hPos := hPos + (lastWidth - width);
{ calculate the width of the tab "glyph" (as a Fixed value) }
tabWidth := BSL(kTabWidth - (FixRound(hPos) mod kTabWidth), 16);
{ increment hPos by width of tab character }
hPos := hPos + tabWidth;
{ hit point within tab glyph? }
if (width < tabWidth) then
begin
{ yes: determine which half of tab glyph was hit }
if (width > tabWidth div 2) then
begin
edge := kTrailingEdge; { second (trailing) half of tab }
offset := offset + 1;
end
else
edge := kLeadingEdge; { first (leading) half of tab }
{ returning -1 (as Fixed) in width means we're finished }
width := $FFFF0000;
end
else
begin
{ hit point is past tab: go on looping }
offset := offset + 1;
width := width - tabWidth;
end;
end; { if width >= 0 }
end; { if tab found }
end; { for }
{ no more tabs in this segment: process the last sub-segment }
if (width >= 0) then
begin
lastWidth := width;
offset := offset + PixelToChar(Ptr(LongInt(pText) + beginChar), textLength - beginChar, slop, lastWidth, Boolean(edge), width, styleRunPosition, tempPoint, tempPoint);
end;
{ round width to nearest integer value }
{ (this is supposed to fix an incompatibility with the WorldScript Power Adapter) }
width := BSL(FixRound(width), 16);
{ return offset }
_WETabPixelToChar := offset;
end; { _WETabPixelToChar }
function _WETabCharToPixel (pText: Ptr;
textLength: LongInt;
slop: Fixed;
offset: LongInt;
direction: Integer;
styleRunPosition: JustStyleCode;
hPos: LongInt;
hWE: WEHandle): Integer;
var
destRect: LongRect;
ii, beginChar: LongInt;
width, totalWidth: Integer;
begin
WEGetDestRect(destRect, hWE);
beginChar := 0;
totalWidth := 0;
{ measure text up to offset, if offset is within this segment }
if (offset < textLength) then
textLength := offset;
for ii := 0 to textLength - 1 do
begin
if (Ptr(LongInt(pText) + ii)^ = kTab) then
begin
{ calculate the pixel width of the subsegment preceding the tab }
width := TextWidth(pText, beginChar, ii - beginChar);
totalWidth := totalWidth + width;
hPos := hPos + width;
{ calculate tab width }
width := kTabWidth - (Integer(hPos - destRect.left) mod kTabWidth);
totalWidth := totalWidth + width;
hPos := hPos + width;
{ go to next subsegment }
beginChar := ii + 1;
end;
end; { for }
{ calculate width of remaining characters }
width := TextWidth(pText, beginChar, textLength - beginChar);
totalWidth := totalWidth + width;
_WETabCharToPixel := totalWidth;
end; { _WETabCharToPixel }
function _WETabLineBreak (pText: Ptr;
textLength: LongInt;
textStart: LongInt;
textEnd: LongInt;
var textWidth: Fixed;
var textOffset: LongInt;
hWE: WEHandle): StyledLineBreakCode;
var
destRect: LongRect;
ii, beginChar: LongInt;
tabWidth: Fixed;
breakCode: StyledLineBreakCode;
begin
WEGetDestRect(destRect, hWE);
breakCode := smBreakOverflow;
beginChar := textStart;
for ii := textStart to textEnd - 1 do
begin
if (Ptr(LongInt(pText) + ii)^ = kTab) then
begin
{ do previous "segment" }
breakCode := StyledLineBreak(pText, textLength, beginChar, ii, 0, textWidth, textOffset);
if ((breakCode <> smBreakOverflow) or (ii >= textLength)) then
Leave;
beginChar := ii + 1;
{ calculate tab width (as a Fixed value) }
tabWidth := BSL(kTabWidth - ((Integer(destRect.right - destRect.left) - FixRound(textWidth)) mod kTabWidth), 16);
{ if tabWidth > pixelWidth we break in tab }
{ don't move tab to next line }
if (tabWidth > textWidth) then
begin
breakCode := smBreakWord;
textOffset := ii + 1;
Leave;
end
else
{ subtract tab width from pixel width }
textWidth := textWidth - tabWidth;
end; { if tab }
end; { for }
{ do last sub-segment }
if ((ii - beginChar >= 0) and (breakCode = smBreakOverflow)) then
{ do the styled break }
breakCode := StyledLineBreak(pText, textLength, beginChar, ii, 0, textWidth, textOffset);
{ return break code }
_WETabLineBreak := breakCode;
end; { _WETabLineBreak }
function WEInstallTabHooks (hWE: WEHandle): OSErr;
label
1;
var
err: OSErr;
begin
{ create routine descriptors }
if (sDrawTextHook = nil) then
begin
sDrawTextHook := NewWEDrawTextProc(@_WETabDrawText);
sPixelToCharHook := NewWEPixelToCharProc(@_WETabPixelToChar);
sCharToPixelHook := NewWECharToPixelProc(@_WETabCharToPixel);
sLineBreakHook := NewWELineBreakProc(@_WETabLineBreak);
end;
{ install the text drawing hook }
err := WESetInfo(weDrawTextHook, @sDrawTextHook, hWE);
if (err <> noErr) then
goto 1;
{ install the PixelToChar hook }
err := WESetInfo(wePixelToCharHook, @sPixelToCharHook, hWE);
if (err <> noErr) then
goto 1;
{ install the CharToPixel hook }
err := WESetInfo(weCharToPixelHook, @sCharToPixelHook, hWE);
if (err <> noErr) then
goto 1;
{ install the line break hook }
err := WESetInfo(weLineBreakHook, @sLineBreakHook, hWE);
1:
{ return result code }
WEInstallTabHooks := err;
end; { WEInstallTabHooks }
function WERemoveTabHooks (hWE: WEHandle): OSErr;
label
1;
var
hook: ProcPtr;
err: OSErr;
begin
hook := nil;
{ remove the text drawing hook }
err := WESetInfo(weDrawTextHook, @hook, hWE);
if (err <> noErr) then
goto 1;
{ remove the PixelToChar hook }
err := WESetInfo(wePixelToCharHook, @hook, hWE);
if (err <> noErr) then
goto 1;
{ remove the CharToPixel hook }
err := WESetInfo(weCharToPixelHook, @hook, hWE);
if (err <> noErr) then
goto 1;
{ remove the line break hook }
err := WESetInfo(weLineBreakHook, @hook, hWE);
1:
{ return result code }
WERemoveTabHooks := err;
end; { WERemoveTabHooks }
function WEIsTabHooks (hWE: WEHandle): Boolean;
var
hook: ProcPtr;
begin
if (sDrawTextHook <> nil) then
{ return TRUE if our tab hooks are installed }
WEIsTabHooks := (WEGetInfo(weDrawTextHook, @hook, hWE) = noErr) & (hook = sDrawTextHook)
else
WEIsTabHooks := false;
end; { WEIsTabHooks }
end.